home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / copymove.swg / 0010_Move File #1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  6.1 KB  |  218 lines
  1. {
  2. I found a source * COPY.PAS * (don't know where anymore or who posted it) and
  3. tried to Write my own move_Files Program based on it.
  4.  
  5. The simple idea is to move the Files specified in paramstr(1) to a destination
  6. directory specified in paramstr(2) and create the directories that do not yet
  7. exist.
  8.  
  9. On a first look it seems just to work out ok. But yet it does not.
  10.  
  11. to help me find the failure set paramstr(1) to any path you want (For example
  12. D:\test\*.txt or whatever) and set paramstr(2) to a non existing path which is
  13. C:\A\B\C\D\E\F\G\H\..\Z\A\B\C\D\E\F\
  14.  
  15. The directories C:\A through C:\A\B\C\D\F\..\Q\R\S will be created and than the
  16. Program hangs.
  17.  
  18. Who can help me find what the mistake is?
  19.  
  20. I Really will be grateful For any kind of help.
  21.  
  22. The code is:
  23. }
  24.  
  25. {$A+,B-,D+,E+,F-,G-,I-,L+,N-,O-,R+,S-,V+,X-}
  26. Program aMOVE;
  27.  
  28. Uses
  29.   Crt, Dos;
  30. Const
  31.   BufSize = 32768;
  32. Var
  33.   ioCode               : Byte;
  34.   SrcFile, DstFile     : File;
  35.   FileNameA,
  36.   FileNameB            : String;
  37.   Buffer               : Array[1..BufSize] of Byte;
  38.   RecsRead             : Integer;
  39.   DiskFull             : Boolean;
  40.   CurrDir              : DirStr;        {Aktuelles Verzeichnis speichern}
  41.   HelpList             : Boolean;       {Hilfe uber mogliche Parameter?}
  42.   i,
  43.   n                    : Integer;
  44.   str                  : String[1];
  45.  
  46.   SDStr                : DirStr;        {Quellverzeichnis}
  47.   SNStr                : NameStr;       {Quelldateiname}
  48.   SEStr                : ExtStr;        {Quelldateierweiterung}
  49.  
  50.   DDStr                : DirStr;        {Zielverzeichnis}
  51.   DNStr                : NameStr;       {Zieldateiname}
  52.   DEStr                : ExtStr;        {Zieldateierweiterung}
  53.  
  54.   SrcInfo              : SearchRec;     {Liste der Quelldateien}
  55.   SubDirStr            : Array [0..32] of DirStr;
  56.   key                  : Char;
  57.  
  58.  
  59.   Procedure SrcFileError(ioCode : Byte);
  60.   begin
  61.     Write(#7, 'I/O result of ', ioCode, ' (decimal) ', #26);
  62.     Case ioCode of
  63.       $01 : WriteLn(' Source File not found.');
  64.       $F3 : WriteLn(' too many Files open.');
  65.     else WriteLn(' "Reset" unknown I/O error.');
  66.     end;
  67.   end;
  68.  
  69.   Procedure DstFileError(ioCode : Byte);
  70.   begin
  71.     Write(#7, 'I/O result of ', ioCode, ' (decimal) ', #26);
  72.     Case ioCode of
  73.       $F0 : WriteLn(' Disk data area full.');
  74.       $F1 : WriteLn(' Disk directory full.');
  75.       $F3 : WriteLn(' too many Files open.');
  76.     else WriteLn(' "ReWrite" unknown I/O error.');
  77.     end;
  78.   end;
  79.  
  80.  
  81.  
  82. Procedure EXPAR;                      {externe Parameter abfragen} begin
  83.   GetDir(0,CurrDir);                  {Aktuelles Verzeichnis speichern}
  84.   if DDStr='' then DDStr:= CurrDir;   {Wenn keine Zialangabe, dann ins
  85.                                        aktuelle Verzeichnis verschieben}
  86.   FSplit(paramstr(1), SDStr, SNStr, SEStr);
  87. end;
  88.  
  89. Procedure Copy2Dest;
  90. begin
  91.   if FileNameB <> FileNameA then
  92.     begin
  93.       Assign(SrcFile, FileNameA);
  94.       Assign(DstFile, FileNameB);
  95.       {* note second parameter in "reset" and "reWrite" of UNTyped Files. *}
  96.       {$I-} Reset(SrcFile, 1); {$I+}
  97.       ioCode := Ioresult;
  98.       if (ioCode <> 0) then SrcFileError(ioCode)
  99.       else
  100.         begin
  101.           {$I-} ReWrite(DstFile, 1); {$I+}
  102.           ioCode := Ioresult;
  103.           if (ioCode <> 0) then DstFileError(ioCode)
  104.           else
  105.             begin
  106.               DiskFull := False;
  107.               While (not EoF(SrcFile)) and (not DiskFull) do
  108.                 begin
  109.                   {* note fourth parameter in "blockread". *}
  110.                   {$I-}
  111.                   BlockRead(SrcFile, Buffer, BufSize, RecsRead);
  112.                   {$I+}
  113.                   ioCode := Ioresult;
  114.                   if ioCode <> 0 then
  115.                     begin
  116.                       SrcFileError(ioCode);
  117.                       DiskFull := True
  118.                     end
  119.                   else
  120.                     begin
  121.                       {$I-}
  122.                       BlockWrite(DstFile, Buffer, RecsRead);
  123.                       {$I+}
  124.                       ioCode := Ioresult;
  125.                       if ioCode <> 0 then
  126.                         begin
  127.                           DstFileError(ioCode);
  128.                           DiskFull := True
  129.                         end
  130.                     end
  131.                 end;
  132.               if not DiskFull then WriteLn(FileNameB)
  133.             end;
  134.           Close(DstFile)
  135.         end;
  136.       Close(SrcFile)
  137.     end
  138.   else WriteLn(#7, 'File can not be copied onto itself.')
  139. end;
  140.  
  141. Procedure ProofDest;
  142. begin
  143.   if length(paramstr(2)) > 67 then begin
  144.     Writeln;
  145.     Writeln(#7,'Invalid destination directory specified.');
  146.     Writeln('Program aborted.');
  147.     Halt(1);
  148.   end;
  149.   FSplit(paramstr(2), DDStr, DNStr, DEStr);
  150.   if copy(DNStr,length(DNStr),1)<>'.' then begin
  151.     insert(DNStr,DDStr,length(DDStr)+1);
  152.     DNStr:='';
  153.   end;
  154.   if copy(DDStr,length(DDStr),1)<>'\' then
  155.     insert('\',DDSTR,length(DDStr)+1);
  156.   SubDirStr[0]:= DDStr;
  157.   For i:= 1 to 20 do begin
  158.     SubDirStr[i]:=copy(DDStr,1,pos('\',DDStr));
  159.     Delete(DDStr,1,pos('\',DDStr));
  160.   end;
  161.   For i:= 32 doWNto 1 do begin
  162.     if SubDirStr[i]= '' then n:= i-1;
  163.   end;
  164.  
  165.   DDStr:= SubDirStr[0];
  166.   SubDirStr[0]:='';
  167.  
  168.   For i:= 1 to n do begin
  169.     SubDirStr[0]:= SubDirStr[0]+SubDirStr[i];
  170.  
  171.     if copy(SubDirStr[0],length(SubDirStr[0]),1)='\' then
  172.       delete(SubDirStr[0],length(SubDirStr[0]),1);
  173.  
  174.  begin
  175.       {$I-}
  176.       MkDir(SubDirStr[0]);
  177.       {$I+}
  178.       if Ioresult = 0 then
  179.       WriteLn('New directory created: ', SubDirStr[0]);
  180.     end;
  181.  
  182.     if copy(SubDirStr[0],length(SubDirStr[0]),1)<>'\' then
  183.       insert('\',SubDirStr[0],length(SubDirStr[0])+1);
  184.   end;
  185. end;
  186.  
  187. Procedure HandleMove;
  188. begin
  189.   FileNameA:= SDStr+SrcInfo.Name;
  190.   FileNameB:= DDStr+SrcInfo.Name;
  191.   Copy2Dest;
  192.   Erase(SrcFile);
  193. end;
  194.  
  195. Procedure ExeMove;
  196. begin
  197.   ProofDest;
  198.   FindFirst(paramstr(1), AnyFile, SrcInfo);
  199.   While DosError = 0 do begin
  200.     HandleMove;
  201.     FindNext(SrcInfo);
  202.   end;
  203. end;
  204.  
  205.  
  206.  
  207. begin
  208.   SDStr:= '';
  209.   SNStr:= '';
  210.   SEStr:= '';
  211.   DDStr:= '';
  212.   DNStr:= '';
  213.   DEStr:= '';
  214.   For i:=0 to 32 do SubDirStr[i]:='';
  215.   ExPar;
  216.   ExeMove;
  217. end.
  218.